#lang racket


(require "../backends/main.rkt"
         "../ast/main.rkt"
         "../base/main.rkt")

(provide (rename-out (evaluate generic-evaluate)
                     (evaluate-toplevel generic-evaluate-toplevel)))


(define (proxy-fn proxy fn)
  (fn proxy))


; points

(define (eval-point proxy node)
  ((proxy-fn proxy proxy-point)
   (point-node-c node)))

         
; lines

(define (eval-arc proxy node)
  ((proxy-fn proxy proxy-arc)
   (arc-node-angle node)
   (arc-node-radius node)))

(define (eval-elliptical-arc proxy node)
  ((proxy-fn proxy proxy-elliptical-arc)
   (elliptical-arc-node-angle node)
   (elliptical-arc-node-x-radius node)
   (elliptical-arc-node-y-radius node)))

(define (eval-ellipse proxy node)
  ((proxy-fn proxy proxy-ellipse)
   (ellipse-node-x-radius node)
   (ellipse-node-y-radius node)))

(define (eval-line proxy node)
  ((proxy-fn proxy proxy-line)
   (line-node-closed? node)
   (line-node-cs node)))

(define (eval-nurbs-curve proxy node)
  ((proxy-fn proxy proxy-nurbs-curve)
   (nurbs-curve-node-controls node)
   (nurbs-curve-node-knots node)))


; surfaces

(define (eval-donut proxy node)
  ((proxy-fn proxy proxy-donut)
   (donut-node-inner-radius node)
   (donut-node-outer-radius node)))

(define (eval-ngon proxy node)
  ((proxy-fn proxy proxy-ngon)
   (ngon-node-width node)
   (ngon-node-sides node)))

(define (eval-nurbs-surface proxy node)
  ((proxy-fn proxy proxy-nurbs-surface)
   (nurbs-surface-node-controls node)
   (nurbs-surface-node-u-knots node)
   (nurbs-surface-node-v-knots node)))

(define (eval-spline proxy node)
  ((proxy-fn proxy proxy-spline)
   (spline-node-closed? node)
   (spline-node-cs node)
   (spline-node-type node)))

(define (eval-star proxy node)
  ((proxy-fn proxy proxy-star)
   (star-node-width node)
   (star-node-sides node)
   (star-node-stride node)))

(define (eval-surface proxy node)
  ((proxy-fn proxy proxy-surface)
   (evaluate proxy (surface-node-shapes node))))


; solids

(define (eval-box proxy node)
  ((proxy-fn proxy proxy-box)
   (box-node-width node)
   (box-node-length node)
   (box-node-height node)))

(define (eval-cone proxy node)
  ((proxy-fn proxy proxy-cone)
   (cone-node-radius node)
   (cone-node-height node)))

(define (eval-cone-frustrum proxy node)
  ((proxy-fn proxy proxy-cone-frustrum)
   (cone-frustrum-node-base-radius node)
   (cone-frustrum-node-top-radius node)
   (cone-frustrum-node-height node)))

(define (eval-cylinder proxy node)
  ((proxy-fn proxy proxy-cylinder)
   (cylinder-node-radius node)
   (cylinder-node-height node)))

(define (eval-pyramid proxy node)
  ((proxy-fn proxy proxy-pyramid)
   (pyramid-node-width node)
   (pyramid-node-sides node)
   (pyramid-node-height node)))

(define (eval-sphere proxy node)
  ((proxy-fn proxy proxy-sphere)
   (sphere-node-radius node)))


; generic shapes

(define (eval-circle proxy node)
  ((proxy-fn proxy proxy-circle)
   (circle-node-type node)
   (circle-node-radius node)))

(define (eval-rectangle proxy node)
  ((proxy-fn proxy proxy-rectangle)
   (rectangle-node-type node)
   (rectangle-node-width node)
   (rectangle-node-length node)))


; transformations

(define (eval-extrude proxy node)
  ((proxy-fn proxy proxy-extrude)
   (extrude-node-length node)
   (evaluate proxy (extrude-node-shape node))))

(define (eval-intersect proxy node)
  ((proxy-fn proxy proxy-intersect)
   (evaluate proxy (intersect-node-shape1 node))
   (evaluate proxy (intersect-node-shape2 node))))

(define (eval-join proxy node)
  ((proxy-fn proxy proxy-join)
   (map (cλ evaluate proxy) (join-node-shapes node))))

(define (eval-loft proxy node)
  ((proxy-fn proxy proxy-loft)
   (loft-node-closed? node)
   (map (cλ evaluate proxy) (loft-node-shapes node))))

(define (eval-move proxy node)
  ((proxy-fn proxy proxy-move)
   (move-node-c node)
   (evaluate proxy (move-node-shape node))))

(define (eval-offset proxy node)
  ((proxy-fn proxy proxy-offset)
   (offset-node-distance node)
   (evaluate proxy (offset-node-shape node))))

(define (eval-rotate proxy node)
  ((proxy-fn proxy proxy-rotate)
   (rotate-node-angle node)
   (rotate-node-normal node)
   (evaluate proxy (rotate-node-shape node))))

(define (eval-scale proxy node)
  ((proxy-fn proxy proxy-scale)
   (scale-node-type node)
   (scale-node-c node)
   (evaluate-node/nodes proxy (scale-node-shape/shapes node))))

(define (eval-subtract proxy node)
  ((proxy-fn proxy proxy-subtract)
   (evaluate proxy (subtract-node-shape1 node))
   (evaluate proxy (subtract-node-shape2 node))))

(define (eval-sweep proxy node)
  ((proxy-fn proxy proxy-sweep)
   (evaluate proxy (sweep-node-path node))
   (evaluate proxy (sweep-node-shape node))))

(define (eval-thicken proxy node)
  ((proxy-fn proxy proxy-thicken)
   (thicken-node-distance node)
   (evaluate proxy (thicken-node-shape node))))

(define (eval-union proxy node)
  ((proxy-fn proxy proxy-union)
   (evaluate proxy (union-node-shape1 node))
   (evaluate proxy (union-node-shape2 node))))


; lang

(define (eval-align proxy node)
  ((proxy-fn proxy proxy-align)
   (align-node-type node)
   (evaluate proxy (align-node-shape node))))

(define (eval-on proxy node)
  ((proxy-fn proxy proxy-on)
   (on-node-type node)
   (evaluate proxy (on-node-shapes node))))

(define (eval-view proxy node)
  ((proxy-fn proxy proxy-view)
   (view-node-type node)
   (view-node-projection-type node)
   (view-node-lens node)
   (evaluate-node/nodes proxy (view-node-shape/shapes node))))


; eval

(define (dispatch-node node)
  (cond
    ; points
    ((point-node? node) eval-point)

    ; lines
    ((arc-node? node) eval-arc)
    ((elliptical-arc-node? node) eval-elliptical-arc)
    ((ellipse-node? node) eval-ellipse)
    ((line-node? node) eval-line)
    ((nurbs-curve-node? node) eval-nurbs-curve)
    ((spline-node? node) eval-spline)
    
    ; surfaces
    ((donut-node? node) eval-donut)
    ((ngon-node? node) eval-ngon)
    ((nurbs-surface-node? node) eval-nurbs-surface)
    ((star-node? node) eval-star)
    ((surface-node? node) eval-surface)

    ; solids
    ((box-node? node) eval-box)
    ((cone-node? node) eval-cone)
    ((cone-frustrum-node? node) eval-cone-frustrum)
    ((cylinder-node? node) eval-cylinder)
    ((pyramid-node? node) eval-pyramid)
    ((sphere-node? node) eval-sphere)
    
    ; generic shapes
    ((circle-node? node) eval-circle)
    ((rectangle-node? node) eval-rectangle)
    
    ; transformations
    
    ;; operations
    ((extrude-node? node) eval-extrude)
    ((intersect-node? node) eval-intersect)
    ((join-node? node) eval-join)
    ((loft-node? node) eval-loft)
    ((move-node? node) eval-move)
    ((offset-node? node) eval-offset)
    ((rotate-node? node) eval-rotate)
    ((scale-node? node) eval-scale)
    ((subtract-node? node) eval-subtract)
    ((sweep-node? node) eval-sweep)
    ((thicken-node? node) eval-thicken)
    ((union-node? node) eval-union)
    
    ;; lang
    ((align-node? node) eval-align)
    ((on-node? node) eval-on)
    ((view-node? node) eval-view)
    
    (else
     (error
      'dispatch-node
      (format "Unhandled node ~A" node)))))

(define (evaluate-node/nodes proxy node/nodes)
  (if (list? node/nodes)
      (map (cλ evaluate proxy) node/nodes)
      (evaluate proxy node/nodes)))

(define (evaluate proxy node)
  (cond
    ((pair? node)
     (cons
      (evaluate proxy (car node))
      (evaluate proxy (cdr node))))
    ((node? node)
     ((dispatch-node node) proxy node))
    (else
     node)))

(define (evaluate-toplevel proxy expr)
  ((proxy-fn proxy proxy-begin-draw) expr)
  (finally
   (evaluate proxy expr)
   (λ () ((proxy-fn proxy proxy-end-draw) expr))))